options(repos = c(CRAN = "https://cran.stanford.edu/"))
install.packages('plotly')
## Installazione pacchetto in 'C:/Users/farac/AppData/Local/R/win-library/4.3'
## (perché 'lib' non è specificato)
install.packages('patchwork')
## Installazione pacchetto in 'C:/Users/farac/AppData/Local/R/win-library/4.3'
## (perché 'lib' non è specificato)
install.packages("psych")
## Installazione pacchetto in 'C:/Users/farac/AppData/Local/R/win-library/4.3'
## (perché 'lib' non è specificato)
install.packages('corrplot')
## Installazione pacchetto in 'C:/Users/farac/AppData/Local/R/win-library/4.3'
## (perché 'lib' non è specificato)
install.packages('dplyr')
## Installazione pacchetto in 'C:/Users/farac/AppData/Local/R/win-library/4.3'
## (perché 'lib' non è specificato)
gini.index<- function(data){
ni=table(data)
fi=ni/length(data)
fi2=fi^2
J= length(table(data))
gini= 1-sum(fi2)
gini.normalizzato = gini/((J-1)/J)
return(gini.normalizzato)
}
fisher_index<-function(data){
mu<-mean(data)
sigma<- sd(data)
n<-length(data)
m3<-sum((data-mu)^3)/n
fisher<-m3/sigma^3
return(fisher)
}
curtosi_index<-function(data){
mu<-mean(data)
sigma<- sd(data)
n<-length(data)
m4<-sum((data-mu)^4)/n
curtosi<-m4/sigma^4-3
}
CV<- function(data){
return(sd(data)/mean(data)*100)
}
library(psych)
#caricamento del dateset
dati<- read.csv('RealEstateTexas.csv', sep= ',')
#controllo delle prime 15 osservazioni
head(dati, 15)
## city year month sales volume median_price listings months_inventory
## 1 Beaumont 2010 1 83 14.162 163800 1533 9.5
## 2 Beaumont 2010 2 108 17.690 138200 1586 10.0
## 3 Beaumont 2010 3 182 28.701 122400 1689 10.6
## 4 Beaumont 2010 4 200 26.819 123200 1708 10.6
## 5 Beaumont 2010 5 202 28.833 123100 1771 10.9
## 6 Beaumont 2010 6 189 27.219 122800 1803 11.1
## 7 Beaumont 2010 7 164 22.706 124300 1857 11.7
## 8 Beaumont 2010 8 174 25.237 136800 1830 11.6
## 9 Beaumont 2010 9 124 17.233 121100 1829 11.7
## 10 Beaumont 2010 10 150 23.904 138500 1779 11.5
## 11 Beaumont 2010 11 150 18.107 150700 1742 11.2
## 12 Beaumont 2010 12 148 21.235 132500 1646 10.5
## 13 Beaumont 2011 1 108 16.200 130700 1677 10.6
## 14 Beaumont 2011 2 108 16.187 116700 1691 10.7
## 15 Beaumont 2011 3 146 22.183 120000 1762 11.3
#controllo dimensioni del dataset
dim(dati)
## [1] 240 8
#salvataggio del numero totale di osservazioni
N<-dim(dati)[1]
Il dataset é composto da 240 osservazioni che registrano i dati di 8 variabili differenti.
le variabili sono le seguenti:
CITY: città. Variabile qualitativa nominale.
YEAR: anno di riferimento. Variabile quantitativa continua da trattare come qualitativa ordinale in questo caso.
MONTH: mese di riferimento. Variabile Qualitativa nominale (ciclica) ma codificata in numeri.
SALES: numero totale di vendite. Variabile quantitativa discreta.
VOLUME: valore totale delle vendite in milioni di dollari. Variabile quantitativa continua.
MEDIAN_PRICE: prezzo mediano di vendita in dollari. Variabile quantitativa continua.
LISTINGS: numero totale di annunci attivi months_inventory. Variabile quantitativa discreta.
MONTH_INVENTORY: quantità di tempo necessaria per vendere tutte le inserzioni correnti al ritmo attuale delle vendite, espresso in mesi. Variabile quantitativa continua.
Le variabile QUANTITATIVE CONTINUE sono tutte su scala di rapporti.
Andiamo a prendere ogni singola variabile e calcoliamo gli indici di posizione, variabilitá e forma.
La variabile city é una variabile QUALITATIVA NOMINALE per tanto ha senso andare a calcolare: le frequenze, da cui otterremo la moda e successivamente plotteremo i dati.
library(ggplot2)
##
## Caricamento pacchetto: 'ggplot2'
## I seguenti oggetti sono mascherati da 'package:psych':
##
## %+%, alpha
attach(dati)
table(city) #calcoliamo le frequenze della variabile city
## city
## Beaumont Bryan-College Station Tyler
## 60 60 60
## Wichita Falls
## 60
ggplot(data = dati)+
geom_bar(aes(x=city),
stat='count',
col='black',
fill='lightblue'
)+
labs(title = 'Distribuzione Delle Cittá',
x='CITTÁ',
y='Frequenza assolute')
Come possiamo vedere dal grafico, la distribuzione di frequenza delle cittá é QUADRIMODALE. Con un valore di 60. Osservando la distribuzione di frequenza possiamo notare che la variabile é EQUAMENTE DISTRIBUITA. pertanto avrá INDICE DI GINI PARI A ZERO. Non ho effettuato il calcolo delle cumulate molto semplicemente perché tutti i valori hanno la medesima frequenza quindi sarebbe un calcolo rindondante e privo di informazioni aggiuntive.
La variabile Year pur essendo una variabile QUANTITATIVA CONTINUA, in questo contesto possiamo trattarla come una variabile QUALITATIVA ORDINALE non avendo molto senso calcolare la media degli anni in questo contesto, pertanto calcoleremo: le frequenze per ottenere successivamente moda e mediana.
table(year) #calcolo delle frequenze assolute per la variabile year
## year
## 2010 2011 2012 2013 2014
## 48 48 48 48 48
moda_year = max(table(year)) #identifico il valore massimo delle frequenze assolute
ggplot(data=dati)+
geom_bar(aes(x=year),
stat='count',
fill='lightblue',
col= 'black'
)+
labs(title = 'Distribuzione di frequenze assolute ANNI',
x = 'Anni',
y = 'Frequenze assolute'
)+
geom_hline(yintercept = moda_year, col='red')+
geom_label(aes(x= year,
y= moda_year,
label= moda_year),
col='red')
summary(year)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2010 2011 2012 2012 2013 2014
In questo contesto come per la variabille CITY siamo davanti a una distribuzione QUADRIMODALE il cui valore é 48.
La variabile month é una variabile QUALITATIVA DI TIPO NOMINALE (ciclica), i numeri equivalgono ai mesi in successione Gennaio Febbraio ecc ecc… Per tanto andremo a calcolare la frequenza di ogni mese.
table(month) #calcolo delle frequenze assolute per la variabile year
## month
## 1 2 3 4 5 6 7 8 9 10 11 12
## 20 20 20 20 20 20 20 20 20 20 20 20
moda_month = max(table(month)) #identifico il valore conl a frequenza massima
ggplot(data=dati)+
geom_bar(aes(x=month),
stat='count',
fill='lightblue',
col= 'black'
)+
scale_x_continuous(breaks = seq(1,12,1)
)+
labs(title = 'Distribuzione di frequenze assolute MESI',
x = 'Mesi',
y = 'Frequenze assolute'
)+
geom_hline(yintercept = moda_month, col='red')+
geom_label(aes(x= month,
y= moda_month,
label= moda_month),
col='red')
Del seguente grafico possiamo vedere che la variabile month “come la variabile anni”, presenta una distribuzione QUADRIMODALE, ne possiamo dedurre che nel database non vi siano “buchi” di mesi ne “buchi” negli anni. Le osservazioni raccolte sono complete.
La variabile quantitativa sales é una variabile QUANTITATIVA DISCRETA per tanto possiamo andare a calcolare: Media, Moda, mediana, Range, Varianza, Deviazione standard, IQR, e Coefficente di Variazione.
#calcoliamo la metá del numero di osservazioni
N/2
## [1] 120
#notiamo che la metá é pari bisogna prendere il valore a metá tra 120 e 121 della serie ordinata di sales
sort(sales)[c(120,121)]
## [1] 175 176
#trovati i valori ne facciamo la media
median_sales<-(175+176)/2
#controlliamo che il calcolo sia corretto con la funzione di default di R
median(sales)
## [1] 175.5
#calcoliamo la somma di tutti i valori e dividiamo il numero di valori, usiamo la media aritmetica
mu_sales<-sum(sales)/N
#verifichiamo che il calcolo sia corretto con la funzione di R
mean(sales)
## [1] 192.2917
Raggruppiamo in classi per avere una visualizzazione migliore della distribuzione e per visualizzare la classe modale.
#decido di dividere in classi di 43 valori per classe
lunghezza_class_sales<- cut(sales,
breaks= seq(79,423,43), right= F, include.lowest = T)
ni=table(lunghezza_class_sales)
fi= table(lunghezza_class_sales)/sum(table(lunghezza_class_sales))*100
NI=cumsum(table(lunghezza_class_sales))
FI= cumsum(table(lunghezza_class_sales)/sum(table(lunghezza_class_sales))*100)
tabella_frequenze<- as.data.frame((cbind(ni, fi, NI, FI)))
ggplot(data = dati)+
geom_bar(aes(x = lunghezza_class_sales),
fill= 'blue',
stat='count',
col= 'black',
)+
labs(title= 'Frequenze assolute sales',
x= "CLASSI SALES",
y= "Frequenze assolute")+
geom_vline(xintercept=2,
col='red',
size=0.5)+
annotate("text", x = 2.05, y = 63, label = 'classe modale', col = 'red')
Ora visualizzziamo la classe mediana che sappiamo essere la classe entro cui cadono il 50% dei nostri dati.
ggplot(data = dati)+
geom_bar(aes(x = lunghezza_class_sales,
y= stat(cumsum(count)/sum(count))),
fill= 'blue',
stat='count',
col= 'black',
)+
geom_vline(xintercept=3,
col='red',
size=0.5)+
annotate("text", x = 3.10, y = 0.85, label = 'classe mediana', col = 'red')+
labs(title = "Distribuzione di frequenze relative cumulate di Sales",
x= 'CLASSI SALES',
y= 'frequenze relative cumulate')
Ci permetterano di fare un confronto successivo in merito alla distribuzioni dei nostri dati quando lo faremo tuttavia vista la grossa differenza tra unitá di misura delle variabile ci conviene prendere in considerazione il CV e non direttamente la devizione standard, grazie a questo confronto potremmo capire quale delle nostre variabili ha una variabilitá maggiore o minore dei dati.
sigma2_sales= sum((sales-mu_sales)^2)/N
sigma_sales= sqrt(sigma2_sales)
var(sales)
## [1] 6344.3
sd(sales)
## [1] 79.65111
describe(sales)
## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 240 192.29 79.65 175.5 184.97 82.28 79 423 344 0.71 -0.34 5.14
range(sales)
## [1] 79 423
IQR(sales)
## [1] 120
summary(sales)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 79.0 127.0 175.5 192.3 247.0 423.0
Questi numeri stanno a significare che la variabile sales ha un range totale di valori registrati che vanno da 79 a 423. Il 50% dei nostri dati si trova compreso tra il primo quartile 127.0 e il terzo quartile 247.0
Ma vediamo questi dati in un boxplot per capire meglio cosa vogliono dire.
quantili<-quantile(sales)
mean_sales <- mean(sales)
median_sales <- median(sales)
minimo= min(sales)
massimo= max(sales)
primo_quartile=as.numeric(quantili[2])
primo_quartile
## [1] 127
terzo_quartile=as.numeric(quantili[4])
ggplot(data=dati) +
geom_boxplot(aes(x=sales),
col='black',
fill="lightblue") +
geom_vline(xintercept=mean_sales,
col='red',
size=0.5) +
geom_vline(xintercept=median_sales,
col='green',
size=0.5) +
geom_vline(xintercept=primo_quartile,
col='blue',
size=0.5) +
geom_vline(xintercept =terzo_quartile,
col='blue',
size=0.5)+
geom_label(aes(y=0.5, x = terzo_quartile, label=terzo_quartile),
col='blue',fill='white', nudge_x =29 )+
geom_label(aes(y=0.5, x = primo_quartile, label=primo_quartile),
col='blue',fill='white', nudge_x =-21.5 )+
geom_label(aes(y = 0.5, x = mean_sales, label = round(mean_sales, 2)),
col='red', fill='white', nudge_x = 24.5) +
geom_label(aes(y = 0.5, x = median_sales, label = round(median_sales, 2)),
col='green', fill='white', nudge_x = -22.5) +
geom_point(aes(x=mean_sales, y=0.5, color='Media'), size=2) +
geom_point(aes(x=median_sales, y=0.5, color='Mediana'), size=2) +
geom_point(aes(x=primo_quartile, y=0.5, color="Primo quartile"), size=2) +
geom_point(aes(x=terzo_quartile, y=0.5, color='Terzo quartile'), size=2) +
labs(title = 'Boxplot distribuzione variabile Sales',
x='SALES',
y= 'Y')+
scale_color_manual(name = "Statistiche",
values = c("Media" = "red", "Mediana" = "green", 'Primo quartile' ='blue', 'Terzo quartile'= 'blue'))
describe(sales)
## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 240 192.29 79.65 175.5 184.97 82.28 79 423 344 0.71 -0.34 5.14
Da questo grafico possiamo capire che la mediana e la moda non coincidono, di consequenza avremmo un’assimetria positiva questo é confermato dall’indice di asimettria di 0.71. Quindi abbiamo code piú lunghe verso destra.
cv_sales<-CV(sales)
cv_sales
## [1] 41.42203
Questo valore ci permetterá successivamente di confrontare le diverse variabili per capire quale ha la variabilitá piú grande senza preoccuparci delle unitá misura o di linee di grandezza differenti
fisher_sales<- fisher_index(sales)
fisher_sales
## [1] 0.7136206
curtosi_sales <- curtosi_index(sales)
curtosi_sales
## [1] -0.33552
La variabile volume é una variabile QUANTITATIVA CONTINUA, vista la tipologia di variabile possiamo andare ad osservare la sua distribuzione di densitá per avere un’idea della distribuzione. Successivamente andremo a calcolare: mediana, media, varianza, deviazione standard, IQR, CV.
attach(dati)
## I seguenti oggetti sono mascherati da dati (pos = 3):
##
## city, listings, median_price, month, months_inventory, sales,
## volume, year
ggplot(data=dati)+
geom_density(aes(x=volume), col='black', fill='green')+
labs(title='Distribuzione di densitá Volume soldi',
x = 'Vendite in milioni di dollari',
y = 'densitá di probabilitá' )
Da questo primo plottaggio notiamo che la distribuzione delle vendite intesa in milioni di dollari ha un andamento simile a quella delle vendite notiamo una concentrazione dei valori nella prima parte del grafico e una coda piú lunga verso destra.
N/2
## [1] 120
sort(volume)[c(120,121)]
## [1] 26.961 27.164
median_volume<-(26.961+27.164)/2
median_volume
## [1] 27.0625
mean_volume<-sum(volume)/N
mean_volume
## [1] 31.00519
quantili_volume<-quantile(volume)
primo_quartile_volume=as.numeric(quantili_volume[2])
terzo_quartile_volume=as.numeric(quantili_volume[4])
quantili_volume
## 0% 25% 50% 75% 100%
## 8.1660 17.6595 27.0625 40.8930 83.5470
primo_quartile_volume
## [1] 17.6595
terzo_quartile_volume
## [1] 40.893
cv_volume<-CV(volume)
cv_volume
## [1] 53.70536
Possiamo notare come la dispersione intorno alla media del volume sia maggiore rispetto alla dispersione intorno alla media delle vendite, di conseguenza possiamo dire che la variabile volume abbia una variabilitiá maggiore rispetto a sales.
fisher_volume<- fisher_index(volume)
fisher_volume
## [1] 0.8792182
curtosi_volume<- curtosi_index(volume)
curtosi_volume
## [1] 0.1505673
La variabile Median Price é una variabile QUANTITATIVO CONTINUA.
ggplot(data=dati)+
geom_density(aes(x=median_price), col='black', fill='purple')+
labs(title='Distribuzione di densitá Median Price',
x='Prezzo mediano',
y='Densitá di probabilitá')
N/2
## [1] 120
sort(median_price)[c(120,121)]
## [1] 134500 134500
median_median_price<-(134500+134500)/2
median_median_price
## [1] 134500
mean_median_price<-sum(median_price)/N
mean_median_price
## [1] 132665.4
quantili_median_price<-quantile(median_price)
primo_quartile_median_price=as.numeric(quantili_median_price[2])
terzo_quartile_median_price=as.numeric(quantili_median_price[4])
quantili_median_price
## 0% 25% 50% 75% 100%
## 73800 117300 134500 150050 180000
primo_quartile_median_price
## [1] 117300
terzo_quartile_median_price
## [1] 150050
cv_median_price<-CV(median_price)
cv_median_price
## [1] 17.08218
fisher_median_price<-fisher_index(median_price)
fisher_median_price
## [1] -0.3622768
curtosi_median_price<-curtosi_index(median_price)
curtosi_median_price
## [1] -0.6427292
La variabile Listings é una variabile QUANTITATIVA DISCRETA.
summary(listings)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 743 1026 1618 1738 2056 3296
3296-743
## [1] 2553
2553/69
## [1] 37
lunghezza_class_listings<- cut(listings,
breaks= seq(743,3296,69), right= F, include.lowest = T)
ni=table(lunghezza_class_listings)
fi= table(lunghezza_class_listings)/sum(table(lunghezza_class_listings))
NI=cumsum(table(lunghezza_class_listings))
FI= cumsum(table(lunghezza_class_listings)/sum(table(lunghezza_class_listings)))
classi<-levels(lunghezza_class_listings)
tabella_frequenze_listings<- data.frame(classi=classi,
ni= as.numeric(ni),
fi= as.numeric(fi),
NI=as.numeric(NI),
FI=as.numeric(FI))
tabella_frequenze_listings$classi <- factor(tabella_frequenze_listings$classi, levels = classi, ordered = TRUE)
ggplot(data=tabella_frequenze_listings )+
geom_col(aes(x=classi, y=ni),
col='black',
fill='lightblue')+
labs(title= 'distribuzione Frequenza assoluta listings',
x= 'Listings',
y= 'frequenza assoluta')+
theme(axis.text.x = element_text(angle = 90, hjust = 1))
N/2
## [1] 120
sort(listings)[c(120,121)]
## [1] 1617 1620
median_listings<-(1617+1620)/2
median_listings
## [1] 1618.5
mean_listings<-sum(listings)/N
mean_listings
## [1] 1738.021
quantili_listings<-quantile(listings)
primo_quartile_listings=as.numeric(quantili_listings[2])
terzo_quartile_listings=as.numeric(quantili_listings[4])
quantili_listings
## 0% 25% 50% 75% 100%
## 743.0 1026.5 1618.5 2056.0 3296.0
primo_quartile_listings
## [1] 1026.5
terzo_quartile_listings
## [1] 2056
cv_listings<-CV(listings)
cv_listings
## [1] 43.30833
fisher_listings<-fisher_index(listings)
fisher_listings
## [1] 0.6454431
curtosi_listings<-curtosi_index(listings)
curtosi_listings
## [1] -0.8101534
La variabile Month Inventory é una variabile QUANTITATIVA CONTINUA.
ggplot(data=dati)+
geom_density(aes(x=months_inventory), col='black', fill='pink')+
labs(title='Distribuzione di densitá months inventory',
x = 'months inventory',
y = 'densitá di probabilitá')
sort(months_inventory)[c(120,121)]
## [1] 8.9 9.0
median_months_inventory<-(8.9+9.0)/2
median_months_inventory
## [1] 8.95
mean_months_inventory<-sum(months_inventory)/N
mean_months_inventory
## [1] 9.1925
quantili_months_inventory<-quantile(months_inventory)
primo_quartile_months_inventory=as.numeric(quantili_months_inventory[2])
terzo_quartile_months_inventory=as.numeric(quantili_months_inventory[4])
quantili_months_inventory
## 0% 25% 50% 75% 100%
## 3.40 7.80 8.95 10.95 14.90
primo_quartile_months_inventory
## [1] 7.8
terzo_quartile_months_inventory
## [1] 10.95
cv_months_inventory<-CV(months_inventory)
cv_months_inventory
## [1] 25.06031
fisher_months_inventory<-fisher_index(months_inventory)
fisher_months_inventory
## [1] 0.04071944
curtosi_months_inventory<-curtosi_index(months_inventory)
curtosi_months_inventory
## [1] -0.1979448
Possiamo affermare che la variabile volume risulta essere quella piú variabile e quella piú assimetrica. L’ho dedotto confrontando i diversi CV. Analizzando la variabilitá intorno alla media e gli indici di Fisher per quanto riguarda l’asimmetria in questo caso positiva, possiamo dedurre che avremmo una concentrazione di dati maggiore nella parte sinistra della curva.
la probabilita di estrarre una riga con i vaori indicati sará pari al numero di casi favorevoli diviso il numerodi casi totali che in questo caso coincidono con il numero di tutte le righe del dataset, i valori di probabilitá calcolati sono espressi in precentuale, per tanto:
#probabilitá che una riga riporti la cittá di beamount:
probabilitá_beamount<-(48/N)*100
probabilitá_beamount
## [1] 20
#probabilitá che una riga riporti il mese di Luglio
probabilitá_Luglio<-(20/N)*100
probabilitá_Luglio
## [1] 8.333333
#probabilitá che una riga riporti il mese di Dicembre 2012
probabilitá_12_2012<- (4/N)*100
probabilitá_12_2012
## [1] 1.666667
dati$mean_price<-numeric(nrow(dati))
for (i in 1:nrow(dati)){
dati$mean_price[i]<-dati$volume[i]/dati$sale[i]*100
}
Mettendo in relazione il numero delle vendite con gli annunci del mercato possiamo avere un indice che ci permette di capire quanto la conversione degli annunci in vendite effettiva sia efficace. Per farlo possiamo aggiungere una colonna al dataset.
Piú questo valore in percentuale é alto piú i nostri annunci si sono trasformati in vendite.
dati$conversion_rate<-numeric(nrow(dati))
dati$conversion_rate <- round((dati$sales / dati$listings) * 100, 0)
library(corrplot)
## corrplot 0.92 loaded
cor_matrix <- cor(dati[, c("conversion_rate", "listings", "sales", "volume", "months_inventory", "median_price",'mean_price')])
corrplot(cor_matrix,col = colorRampPalette(c("blue", "lightblue", "white"))(10), method='color', addCoef.col = 'black',number.cex = 0.7,tl.cex = 0.6, tl.col = "black", cl.cex = 0.6)
Grazie alla matrice di correlazione possiamo fare alcune considerazioni interessanti in merito al conversion rate:
Come potevamo immaginare si osserva una correlazione media positiva tra il volume totale di soldi e le vendite.
Il conversion rate é inverso al month_inventory, nel senso che a un aumento del conversion rate corrisponde una diminuzione del month inventory in sostanza piú l’indice di conversione aumenta piú il mercato si svuota.
Tra vendite, indice di conversione, annunci e month inventory posiamo notare diverse cose interressanti; piú aumentano gli annunci piú le vendite aumentano ma allo stesso tempo piú aumenta l’indice di conversione piú gi annunci diminuiscono, ma notiamo anche che all’aumentare degli annunci aumenta anche il month inventory; quindi anziché aumentare gli annunci per alzare le vendite rischiando di aumentare il month inventory che come si vede impatta negativamente sull’indice di conversione, potremmo andare a suggerire azioni di marketing piú efficenti o aggressive per vendere gli annunci giá presenti sul mercato, ottimizzare il nostro indice di conversione e, quando questo smette di crescere, solo in quel momento agire su un aumento degli annunci per risalire sulle vendite: cosí potremmo evitare eventuali saturazioni di mercato, mantenendo una certa costanza. Tenere monitorato l’indice di vendita ci permette di capire in quali zone le conversioni sono ottimali; limitando cosi gli annunci perché quelli giá presenti sul mercato sono efficaci; cosi ci riserveremo di uscire con altri annunci quando l’indice si stabilizza o sta per scendere per aumentare le vendite e tornare ad una situazione ottimale per aumentare vendite e volume di soldi.
Il mercato ad una prima occhiata sembra abbastanza stabile alla variazione del prezzo: vediamo che l’aumento del prezzo medio non va ad influire negativamente su vendite o indice di conversione.
Raggruppamento per città: media delle vendite del volume e del prezzo mediano
library(dplyr)
##
## Caricamento pacchetto: 'dplyr'
## I seguenti oggetti sono mascherati da 'package:stats':
##
## filter, lag
## I seguenti oggetti sono mascherati da 'package:base':
##
## intersect, setdiff, setequal, union
dati %>%
group_by(city) %>%
summarise(mean_sales=mean(sales),
mean_volume=mean(volume),
median_price=mean(median_price))
## # A tibble: 4 × 4
## city mean_sales mean_volume median_price
## <chr> <dbl> <dbl> <dbl>
## 1 Beaumont 177. 26.1 129988.
## 2 Bryan-College Station 206. 38.2 157488.
## 3 Tyler 270. 45.8 141442.
## 4 Wichita Falls 116. 13.9 101743.
dati %>%
group_by(city,year) %>%
summarise(
mean_median_price=mean(median_price),
cv_median_price=CV(median_price))
## `summarise()` has grouped output by 'city'. You can override using the
## `.groups` argument.
## # A tibble: 20 × 4
## # Groups: city [4]
## city year mean_median_price cv_median_price
## <chr> <int> <dbl> <dbl>
## 1 Beaumont 2010 133117. 10.0
## 2 Beaumont 2011 125642. 7.64
## 3 Beaumont 2012 126533. 6.30
## 4 Beaumont 2013 132400 5.88
## 5 Beaumont 2014 132250 7.44
## 6 Bryan-College Station 2010 153533. 3.57
## 7 Bryan-College Station 2011 151417. 2.45
## 8 Bryan-College Station 2012 153567. 4.62
## 9 Bryan-College Station 2013 159392. 3.41
## 10 Bryan-College Station 2014 169533. 4.59
## 11 Tyler 2010 135175 3.54
## 12 Tyler 2011 136217. 6.24
## 13 Tyler 2012 139250 5.73
## 14 Tyler 2013 146100 4.60
## 15 Tyler 2014 150467. 5.68
## 16 Wichita Falls 2010 98942. 10.5
## 17 Wichita Falls 2011 98142. 10.8
## 18 Wichita Falls 2012 100958. 12.2
## 19 Wichita Falls 2013 105000 9.89
## 20 Wichita Falls 2014 105675 11.8
Da una prima occhiata possiamo notare come la cittá Bryant Collage Station sia, in termini di vendite e in termini di volume totale di soldi, il mercato piú variabile se pur registrando un prezzo mediano meno variabile rispetto alle altre cittá soprattutto se confrontato con la cittá di Wichita Falls.
ggplot(data=dati) +
geom_boxplot(aes(x=city, y=median_price),
col='black',
fill="lightblue")+
labs(title= 'confronto prezzo mediano delle diverse cittá',
x= 'cittá',
y= 'prezzo mediano')
Possiamo notare che il valore piú alto del prezzo mediano sia quello della cittá di Bryan-Collage Station.
dati_aggregati_citta <- dati %>%
group_by(year, city)
box_plot_confronto_sales<-ggplot(data = dati_aggregati_citta, aes(x=factor(year), y=volume, fill=city)) +
geom_boxplot(aes(x= factor(year),
y= sales,
fill = city))
box_plot_confronto_sales
Stesso grafico ma con plotly per visualizzare tutti gli indici di distribuzione e la mediana direttamente sul grafico.
library(plotly)
##
## Caricamento pacchetto: 'plotly'
## Il seguente oggetto è mascherato da 'package:ggplot2':
##
## last_plot
## Il seguente oggetto è mascherato da 'package:stats':
##
## filter
## Il seguente oggetto è mascherato da 'package:graphics':
##
## layout
interactive_boxplot_sales<- plot_ly(data= dati, x= ~factor(year), y=~sales, color=~city, type='box', opacity= 1.5)%>%
layout(
title= "Distribuzione Totale delle Vendite per Anno e Cittá",
xaxis= list(title= 'Anno'),
yaxis= list(title= 'Vendite'),
boxmode= 'group'
)
interactive_boxplot_sales
Possiamo notare come Bryant Collage in termini di vendite sia il mercato píu variabile. Il valore mediano delle vendite tende a crescere in tutti i mercati ad eccezione di wichita Falls. Apparantemente il mercato piú promettente sembra il mercato della cittá di Tyler, che registra un valore mediano di vendita notevolmente piú alto rispetto agli altri mercati incluso Bryan Collage. Possiamo oltresi notare che il valore mediano delle vendite della cittá di Beaumount si allinea se non supera il valore corrispondente a quello di Bryant_Collage, solo nell’ultimo anno il distacco tra i due aumenta considerevolmente a favore di Bryant-Collage.
interactive_boxplot_volume<- plot_ly(data= dati, x= ~factor(year), y=~volume, color=~city, type='box', opacity= 1.5)%>%
layout(
title= "Distribuzione Totale del volume di profitti per Anno e Cittá",
xaxis= list(title= 'Anno'),
yaxis= list(title= 'milioni di dollari'),
boxmode= 'group'
)
interactive_boxplot_volume
Anche per la distribuzione del volume totale dei soldi possiamo notare un andamento simile a quello giá osservato per le vendite. Notiamo un aumento della variabilitá del volume dei profitti per quanto riguarda la cittá di Bryant_Collage con una lieve contrazione nell’ultimo anno, con un valore mediano progressivamente in aumento nel corso degli anni. La cittá di Tyler mantiene una variabilitá ridotta nel corso degli anni ma il volume di profitti mediano raggiunge livelli piú alti.
interactive_boxplot_prezzo_mediano<- plot_ly(data= dati, x= ~factor(year), y=~median_price, color=~city, type='box', opacity= 1.5)%>%
layout(
title= "Distribuzione del prezzo mediano delle case per anno e cittá",
xaxis= list(title= 'Anno'),
yaxis= list(title= 'Prezzo mediano'),
boxmode= 'group'
)
interactive_boxplot_prezzo_mediano
Per quanto concerne il prezzo mediano delle case possiamo notare come Bryan-Collage abbia fatto registrare valori piú alti. Notiamo un trend di crescita piú significativo sia per quanto riguarda Bryan sia per Tyler; le altre due cittá non fanno registrare particolari fluttazioni nel prezzo mediano. Notiamo oltresi che per quanto riguarda la variabilitá del prezzo mediano le due cittá piú variabili in questo caso sono Beaumont e Wichita Falls.
ggplot(dati, aes(x= factor(month), y= sales, fill=city))+
geom_bar(stat='identity', position= 'stack')+
facet_wrap(~year, scales = 'free_x', ncol= 3)+
labs(title='vendite totali per mese e cittá',x= 'mesi', y= 'vendite totali', fill= 'city')
dati <- dati %>%
group_by(year, month) %>%
mutate(total_sales = sum(sales),
percent_sales = sales / total_sales * 100) %>%
ungroup()
ggplot(data = dati)+
geom_bar(aes(x = factor(month), y= percent_sales, fill= city),
stat= 'identity', position= 'stack')+
facet_wrap(~year, scales = 'free_x', ncol= 3)+
labs(title='vendite totali per mese e cittá',x= 'mesi', y= 'vendite totali', fill= 'city')
Questi due grafici ci fanno capire come nel tempo si siano evolute le vendite nelle diverse cittá; possiamo notare come il grafico normalizzato faccia emergere che il mercato dove le vendite sono inferiori sia quello di Wichita Falls. Possiamo oltresí dire che gli altri tre mercati in termini di vendite sono quelli piú interessanti in particolare Bryan e Tyler.
new_dati<- dati%>%
group_by(city)%>%
mutate(time=row_number())
print(new_dati)
## # A tibble: 240 × 13
## # Groups: city [4]
## city year month sales volume median_price listings months_inventory
## <chr> <int> <int> <int> <dbl> <dbl> <int> <dbl>
## 1 Beaumont 2010 1 83 14.2 163800 1533 9.5
## 2 Beaumont 2010 2 108 17.7 138200 1586 10
## 3 Beaumont 2010 3 182 28.7 122400 1689 10.6
## 4 Beaumont 2010 4 200 26.8 123200 1708 10.6
## 5 Beaumont 2010 5 202 28.8 123100 1771 10.9
## 6 Beaumont 2010 6 189 27.2 122800 1803 11.1
## 7 Beaumont 2010 7 164 22.7 124300 1857 11.7
## 8 Beaumont 2010 8 174 25.2 136800 1830 11.6
## 9 Beaumont 2010 9 124 17.2 121100 1829 11.7
## 10 Beaumont 2010 10 150 23.9 138500 1779 11.5
## # ℹ 230 more rows
## # ℹ 5 more variables: mean_price <dbl>, conversion_rate <dbl>,
## # total_sales <int>, percent_sales <dbl>, time <int>
library(ggplot2)
plot_conversion_rate<-ggplot(data= new_dati, aes(x = time, y = conversion_rate, color = city)) +
geom_line() +
labs(title = "Andamento dell'indice di conversione per Città",
x = "Mese (da 1 a 60)",
y = "indice di conversione",
color = "Città")+
scale_x_continuous(breaks = seq(1,60,1))+
geom_vline(xintercept=12,
col='blue',
size=0.3) +
geom_vline(xintercept=24,
col='blue',
size=0.3) +
geom_vline(xintercept=36,
col='blue',
size=0.3) +
geom_vline(xintercept =48,
col='blue',
size=0.3)+
geom_vline(xintercept =60,
col='blue',
size=0.3)+
annotate("text", x = 12, y = 39, label = '2010', col = 'blue') +
annotate("text", x = 24, y = 39, label = '2011', col = 'blue') +
annotate("text", x = 36, y = 39, label = '2012', col = 'blue') +
annotate("text", x = 48, y = 39, label = '2013', col = 'blue')+
annotate("text", x = 60, y = 39, label = '2014', col = 'blue')
theme(legend.text = element_text(size = 6),
legend.title = element_text(size = 9))
## List of 2
## $ legend.text :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : num 6
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi FALSE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ legend.title:List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : num 9
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi FALSE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## - attr(*, "class")= chr [1:2] "theme" "gg"
## - attr(*, "complete")= logi FALSE
## - attr(*, "validate")= logi TRUE
plot_volume<-ggplot(data= new_dati, aes(x = time, y = volume, color = city))+
geom_line() +
labs(title = "Andamento del volume di soldi in mil",
x = "Mese (da 1 a 60)",
y = "soldi in mil",
color = "Città")+
scale_x_continuous(breaks = seq(1,60,1))+
geom_vline(xintercept=12,
col='blue',
size=0.3) +
geom_vline(xintercept=24,
col='blue',
size=0.3) +
geom_vline(xintercept=36,
col='blue',
size=0.3) +
geom_vline(xintercept =48,
col='blue',
size=0.3)+
geom_vline(xintercept =60,
col='blue',
size=0.3)+
annotate("text", x = 12, y = 82, label = '2010', col = 'blue') +
annotate("text", x = 24, y = 82, label = '2011', col = 'blue') +
annotate("text", x = 36, y = 82, label = '2012', col = 'blue') +
annotate("text", x = 48, y = 82, label = '2013', col = 'blue')+
annotate("text", x = 60, y = 82, label = '2014', col = 'blue')
theme(legend.text = element_text(size = 6),
legend.title = element_text(size = 9))
## List of 2
## $ legend.text :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : num 6
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi FALSE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ legend.title:List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : num 9
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi FALSE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## - attr(*, "class")= chr [1:2] "theme" "gg"
## - attr(*, "complete")= logi FALSE
## - attr(*, "validate")= logi TRUE
plot_sales<-ggplot(data= new_dati, aes(x = time, y = sales, color = city))+
geom_line() +
labs(title = "Andamento delle vendite",
x = "Mese (da 1 a 60)",
y = "vendite",
color = "Città")+
scale_x_continuous(breaks = seq(1,60,1))+
geom_vline(xintercept=12,
col='blue',
size=0.3) +
geom_vline(xintercept=24,
col='blue',
size=0.3) +
geom_vline(xintercept=36,
col='blue',
size=0.3) +
geom_vline(xintercept =48,
col='blue',
size=0.3)+
geom_vline(xintercept =60,
col='blue',
size=0.3)+
annotate("text", x = 12, y = 425, label = '2010', col = 'blue') +
annotate("text", x = 24, y = 425, label = '2011', col = 'blue') +
annotate("text", x = 36, y = 425, label = '2012', col = 'blue') +
annotate("text", x = 48, y = 425, label = '2013', col = 'blue')+
annotate("text", x = 60, y = 425, label = '2014', col = 'blue')
theme(legend.text = element_text(size = 6),
legend.title = element_text(size = 9))
## List of 2
## $ legend.text :List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : num 6
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi FALSE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## $ legend.title:List of 11
## ..$ family : NULL
## ..$ face : NULL
## ..$ colour : NULL
## ..$ size : num 9
## ..$ hjust : NULL
## ..$ vjust : NULL
## ..$ angle : NULL
## ..$ lineheight : NULL
## ..$ margin : NULL
## ..$ debug : NULL
## ..$ inherit.blank: logi FALSE
## ..- attr(*, "class")= chr [1:2] "element_text" "element"
## - attr(*, "class")= chr [1:2] "theme" "gg"
## - attr(*, "complete")= logi FALSE
## - attr(*, "validate")= logi TRUE
interactive_plot_conversation_rate<- ggplotly(plot_conversion_rate)%>%
layout(title = "Andamento dell'indice",
xaxis = list(title = "Mese (da 1 a 60)"),
yaxis = list(title = "Indice di conversione"))
interactive_plot_volume<- ggplotly(plot_volume)%>%
layout(title = "Andamento volume di soldi",
xaxis = list(title = "Mese (da 1 a 60)"),
yaxis = list(title = "Soldi in mil"))
interactive_plot_sales<- ggplotly(plot_sales)%>%
layout(title = "Andamento vendite",
xaxis = list(title = "Mese (da 1 a 60)"),
yaxis = list(title = "vendite"))
interactive_plot_conversation_rate
interactive_plot_volume
interactive_plot_sales
Possiamo definire il mercato di Bryan_Collage il mercato immobiliare piú Frizzante rispetto agli altri, osservando la line chart dell’indice di conversione lungo tutto i mesi possiamo notare come nel periodo primaverile/estivo la conversione degli annunci in vendite sia molto elevata. Questo fatto é legato molto probabilmente, oltre che da efficaci strategie di vendite e marketing, anche dalla zona di interesse: effettuando una ricerca online emerge che il Bryant Collage Station é una cittá studentesca e universitaria, l’indice di vendita inizia ad aumentare ad inizio primavera colmando nel periodo estivo, che coincide con l’inizio delle lezioni e la chiusura delle iscrizioni. Non ho effettuato altre ricerche ma possiamo supporre che questo indice di conversione particolarmente alto possa anche essere dovuto a un aumento dell’attivitá studentesca nel corso degli ultimi anni e al numero degli abitanti che si attestano circa a 215,000 persone.
La variazione del CV del prezzo mediano in Bryan_Collage é aumentata nel corso degli anni tuttavia non in maniera significativa, questo ci dice che la variabilitá del valore medio delle case non é particolarmente alta, probabilmente il valore degli immobili nell’area é abbastanza omogeneo.
Tyler invece é un mercato diverso ha un pool di persone notevolmente ridotto rispetto a Bryant-collage contandone all’incirca 106,000. Possiamo notare come seppur l’indice di conversione sia notevolmente piú basso rispetto al Bryant-College, questo mercato faccia registrare un trend delle vendite e un trend di profitti in aumento nel corso degli ultimi anni. Possiamo notare come l’indice di conversione in questa cittá sia particolarmente basso, quindi potrebbe essere una buona idea quella di suggerire eventuali azioni di marketing finalizzate ad ottimizzare l’indice di conversione per aumentare le vendite e quindi ulterirormente i profitti.
Per quanto riguarda le altre due cittá possiamo affermare che Beaumont segua gli stessi trend delle cittá sopra descritte seppur in maniera piú lieve. Wichita Falls se pur avendo un buon indice di conversione tuttavia fa registrare vendite e volume di soldi inferiori, per questa cittá potrebbe essere una buona idea aumentare invece gli annunci visto che tra le cittá é quella che ha fatto registrare i livelli piú bassi di listings; cosi facendo si potrebbero aumentare le vendite aumentando cosi anche il volume dei profitti.
Le line chart, fanno emergere che i movimenti maggiori del mercato immobiliare si registrano principalmente nei periodi a cavallo tra inizio primavera e periodo estivo per poi scendere progressivamente in autunno facendo registrare i picchi negativi nella stagione invernale, grazie a questa informazione é possibile capire in quali periodi conviene intervenire per massimizzare vendite e profitti con azioni di marketing.